perm filename FETCH.SAI[REV,MUS] blob
sn#290440 filedate 1977-06-23 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 ENTRY
C00004 00003 EXTERNAL INTEGER PROCEDURE incr_prime(
C00005 00004 DEFINE PREFIX_EQU(s1,s2)=
C00006 00005 ∂ Break table declarations.
C00008 00006 INTERNAL BOOLEAN PROCEDURE yes_fetch(
C00010 00007 INTERNAL BOOLEAN PROCEDURE file_fetch(
C00014 00008 INTERNAL BOOLEAN PROCEDURE fix_fetch(
C00016 00009 INTERNAL BOOLEAN PROCEDURE real_fetch(
C00019 00010 INTERNAL BOOLEAN PROCEDURE #samp_fetch(
C00022 00011 ∂ Sneaky TTY input routines.
C00023 00012 INTERNAL PROCEDURE command_read(
C00027 00013 END "FETCH"
C00028 ENDMK
C⊗;
ENTRY;
BEGIN "FETCH"
REQUIRE "HEADER.SAI" SOURCE_FILE;
∂ Ken Shoemake. December 1976.
This module acts as a sort of lexical scanner for input strings. It
includes routines to look for various things from file names to yes/no
replies. It also includes a routine for eating input from either a
file or a TTY. Scanning routines use the convention that TRUE is
returned if an entity of the desired sort is found, else FALSE.
Default parameters may be supplied. They will be unaltered if no
corresponding parameter is found in the scan.
;
EXTERNAL INTEGER PROCEDURE incr_prime(
INTEGER n, incr(0));
DEFINE PREFIX_EQU(s1,s2)=
⊂EQU(s1[1 FOR LENGTH(s2)],s2[1 FOR LENGTH(s1)])⊃;
∂ Break table declarations.;
INTERNAL INTEGER DEVICEBREAKS,
TOKENBREAKS, DELIMITERBREAKS,
PERIODBREAKS, COMMABREAKS,
LINEBREAKS, CMMANDBREAKS; ∂ Funny name avoids LOADER conflict.;
PROCEDURE init_breaks;
BEGIN "init breaks"
DEVICEBREAKS ← GETBREAK;
SETBREAK(DEVICEBREAKS,":",NULL,"INSK");
DELIMITERBREAKS ← GETBREAK;
SETBREAK(DELIMITERBREAKS,SP&TAB&LF,CR,"INSK");
TOKENBREAKS ← GETBREAK;
SETBREAK(TOKENBREAKS,SP&TAB,SP&TAB,"XNRK");
LINEBREAKS ← GETBREAK;
SETBREAK(LINEBREAKS,LF,CR,"INSK");
PERIODBREAKS ← GETBREAK;
SETBREAK(PERIODBREAKS,".",NULL,"INSK");
COMMABREAKS ← GETBREAK;
SETBREAK(COMMABREAKS,",",NULL,"INSK");
CMMANDBREAKS ← GETBREAK;
SETBREAK(CMMANDBREAKS,"_ABCDEFGHIJKLMNOPQRSTUVWXYZ#",NULL,"XNRK");
END "init breaks";
REQUIRE init_breaks INITIALIZATION;
INTERNAL BOOLEAN PROCEDURE yes_fetch(
REFERENCE STRING arg;
REFERENCE BOOLEAN flag);
∂ Look for either a Yes or No reply. Prefixes (i.e. Y/N) suffice.
;
BEGIN "yes fetch"
BOOLEAN found;
STRING tmp;
INTEGER break;
found ← TRUE;
tmp ← SCAN(arg,DELIMITERBREAKS,break);
IF
LENGTH(tmp) = 0
THEN
found ← FALSE
ELSE IF
PREFIX_EQU(tmp,"YES")
THEN BEGIN
flag ← TRUE;
END
ELSE IF
PREFIX_EQU(tmp,"NO")
THEN BEGIN
flag ← FALSE;
END
ELSE
found ← FALSE;
IF
¬found
THEN
arg ← tmp&break&arg;
SCAN(arg,TOKENBREAKS,break);
RETURN(found);
END "yes fetch";
INTERNAL BOOLEAN PROCEDURE file_fetch(
REFERENCE STRING arg;
REFERENCE STRING device, file);
∂ Look for a file name. The user's alias PPN is used to fill in holes
not already filled by the defaults or string. DSK is used as the default
device if a null device would otherwise result. Abbreviated PPNs are fine.
;
BEGIN "file fetch"
BOOLEAN found;
STRING tmp;
INTEGER name, exten, ppn,
default_name, default_exten, default_ppn,
alias_ppn, login_ppn,
break;
DEFINE PROJ='777777000000, PROG='777777;
found ← FALSE;
tmp ← SCAN(arg,DEVICEBREAKS,break);
IF
break = ":"
THEN BEGIN
device ← tmp[1 FOR 6];
IF
EQU(device,NULL)
THEN
device ← "DSK";
found ← TRUE;
END
ELSE
arg ← tmp&(IF break = 0 THEN NULL ELSE break)&arg;
default_name ← CVFIL(file,default_exten,default_ppn);
alias_ppn ← call(0,"DSKPPN");
login_ppn ← call(0,"GETPPN");
IF
default_ppn LAND PROJ = 0
THEN
default_ppn ← default_ppn LOR (alias_ppn LAND PROJ);
tmp ← SCAN(arg,DELIMITERBREAKS,break);
name ← CVFIL(tmp,exten,ppn);
IF
name = 0
THEN
name ← default_name
ELSE
found ← TRUE;
IF
exten = 0
THEN BEGIN
STRING t;
t ← SCAN(tmp,PERIODBREAKS,break);
IF
break ≠ "."
THEN BEGIN
tmp ← t;
exten ← default_exten;
END;
END
ELSE
found ← TRUE;
IF
ppn LAND PROJ = 0
THEN
ppn ← ppn LOR (default_ppn LAND PROJ)
ELSE
found ← TRUE;
IF
ppn LAND PROG = 0
THEN BEGIN
STRING t;
t ← SCAN(tmp,COMMABREAKS,break);
IF
(default_ppn LAND PROG) ≠ 0
THEN
ppn ← ppn LOR (default_ppn LAND PROG)
ELSE
IF
break = ","
THEN BEGIN
ppn ← ppn LOR (login_ppn LAND PROG);
found ← TRUE;
END
ELSE
ppn ← ppn LOR (alias_ppn LAND PROG);
END
ELSE
found ← TRUE;
file ← CV6STR(name)&
(IF exten = 0 THEN NULL ELSE "."&CV6STR(exten)[1 FOR 3])&
(IF ppn = 0 THEN NULL ELSE
("["&CVXSTR(ppn)[1 FOR 3]&","&
CVXSTR(ppn)[4 FOR 3]&"]"));
SCAN(arg,TOKENBREAKS,break);
RETURN(found);
END "file fetch";
INTERNAL BOOLEAN PROCEDURE fix_fetch(
REFERENCE STRING arg;
REFERENCE STRING fix);
∂ Look for one of GAIN DELAY or TIME. Of limited utility outside of
REVED. A useful generalization would be to take a collection of words
and look for one of them.
;
BEGIN "fix fetch"
BOOLEAN found;
STRING tmp;
INTEGER break;
found ← TRUE;
tmp ← SCAN(arg,DELIMITERBREAKS,break);
IF
LENGTH(tmp) = 0
THEN
found ← FALSE
ELSE IF
PREFIX_EQU(tmp,"GAIN")
THEN
fix ← "gain"
ELSE IF
PREFIX_EQU(tmp,"DELAY")
THEN
fix ← "delay"
ELSE IF
PREFIX_EQU(tmp,"TIME")
THEN
fix ← "decay"
ELSE
found ← FALSE;
IF
¬found
THEN
arg ← tmp&break&arg;
SCAN(arg,TOKENBREAKS,break);
RETURN(found);
END "fix fetch";
INTERNAL BOOLEAN PROCEDURE real_fetch(
REFERENCE STRING arg;
REFERENCE REAL value, factor);
∂ Look for a SAIL style real constant. If * or / is given instead, value
is returned multiplied by either the fetched or default factor. If the
default factor passed to this routine is zero, this feature is omitted.
;
BEGIN "real fetch"
BOOLEAN found;
REAL realv;
INTEGER op,
break;
found ← FALSE;
op ← " ";
IF
factor ≠ 0
THEN
IF
arg[1 FOR 1] = "*"
∨
arg[1 FOR 1] = "/"
THEN BEGIN
op ← LOP(arg);
found ← TRUE;
END;
IF
"0" ≤ arg[1 FOR 1] ≤ "9"
∨
arg[1 FOR 1] = "."
∨
arg[1 FOR 1] = "@"
∨
arg[1 FOR 1] = "-"
∨
arg[1 FOR 1] = "+"
THEN
realv ← REALSCAN(arg,break)
ELSE
break ← -1;
IF
break = "K"
∧
op = " "
THEN BEGIN
realv ← realv*1000.0;
arg ← arg[2 TO ∞];
found ← TRUE;
END;
IF
op = " "
THEN BEGIN
IF
break ≠ -1
THEN BEGIN
value ← realv;
found ← TRUE;
END;
END
ELSE BEGIN
IF
break ≠ -1
THEN BEGIN
factor ← realv;
found ← TRUE;
END;
CASE
op
OF BEGIN
["*"] value ← value*factor;
["/"] value ← value/factor
END;
END;
SCAN(arg,TOKENBREAKS,break);
RETURN(found);
END "real fetch";
INTERNAL BOOLEAN PROCEDURE #samp_fetch(
REFERENCE STRING arg;
REFERENCE INTEGER value, offset);
∂ Look for an integer presumed to represent number of samples for a
reverberator. If + or - is seen first, then value is offset that many
prime numbers to a resulting prime.
;
BEGIN "#samp fetch"
BOOLEAN found;
INTEGER op,
ntgrv,
break;
found ← FALSE;
op ← " ";
IF
arg[1 FOR 1] = "+"
THEN BEGIN
op ← LOP(arg);
found ← TRUE;
END
ELSE IF
arg[1 FOR 1] = "-"
THEN BEGIN
op ← LOP(arg);
offset ← offset*(-1);
found ← TRUE;
END;
IF
"0" ≤ arg[1 FOR 1] ≤ "9"
∨
arg[1 FOR 1] = "."
∨
arg[1 FOR 1] = "@"
∨
arg[1 FOR 1] = "-"
∨
arg[1 FOR 1] = "+"
THEN
ntgrv ← INTSCAN(arg,break)
ELSE
break ← -1;
IF
break ≠ -1
THEN BEGIN
CASE
op
OF BEGIN
[" "] value ← ntgrv;
["+"] offset ← ntgrv;
["-"] offset ← -ntgrv
END;
found ← TRUE;
END;
IF
¬(op = " ")
THEN
value ← incr_prime(value,offset);
offset ← ABS offset;
SCAN(arg,TOKENBREAKS,break);
RETURN(found);
END "#samp fetch";
∂ Sneaky TTY input routines.;
INTERNAL INTEGER PROCEDURE SNEAKW;
∂ Look at the input character, but leave it in the TTY buffer.
;
START_CODE "SNEAKW"
DEFINE SNEAKWUUO='047000400063;
SNEAKWUUO 1,;
END "SNEAKW";
INTERNAL BOOLEAN PROCEDURE INSKIP(
INTEGER mode);
START_CODE "INSKIP"
DEFINE INSKIPUUO='051540000000;
MOVE 2,mode;
SETO 1,;
INSKIPUUO 0(2);
SETZ 1,;
END "INSKIP";
DEFINE INSKIPL=⊂INSKIP(1)⊃,
INSKIPC=⊂INSKIP(0)⊃;
INTERNAL PROCEDURE command_read(
REFERENCE STRING the_command, the_arguments;
REFERENCE BOOLEAN the_file_flag;
INTEGER the_in_channel;
REFERENCE INTEGER the_in_eof, the_in_break;
STRING immediate_chars("←→↔"));
∂ Get command lines from either the TTY or the given channel.
Immediate chars do not require carriage return if typed before previous
characters are backspaced over, i.e., they have to be the first thing
typed except for initial backspaces. This is an artifact of how this
feature is implemented.
;
BEGIN "command read"
INTEGER break, i;
IF
¬the_file_flag
THEN BEGIN "read from TTY"
the_command ← SNEAKW;
FOR
i ← 1 STEP 1
UNTIL
LENGTH(immediate_chars)
DO
IF
the_command = immediate_chars[i FOR 1]
THEN BEGIN
IF
the_command ≠ INCHRW
THEN
PRINT(↓,"Fast aren't you?",↓);
PRINT(↓);
the_arguments ← NULL;
RETURN;
END;
the_command ← INCHWL;
END "read from TTY"
ELSE BEGIN "read from FILE"
IF
the_in_eof
THEN BEGIN
the_command ← ";";
the_arguments ← NULL;
RELEASE(the_in_channel);
the_file_flag ← FALSE;
RETURN;
END;
the_command ← INPUT(the_in_channel,LINEBREAKS);
WHILE
the_in_break = 0 ∧ ¬the_in_eof
DO
the_command ← the_command&INPUT(the_in_channel,LINEBREAKS);
∂ Unsightly now so omitted: PRINT(the_command,"| ");
FOR
i ← 1 STEP 1
UNTIL
LENGTH(immediate_chars)
DO
IF
the_command = immediate_chars[i FOR 1]
THEN BEGIN
the_arguments ← NULL;
RETURN;
END;
END "read from FILE";
the_arguments ← the_command;
SCAN(the_arguments,TOKENBREAKS,break);
the_command ← SCAN(the_arguments,CMMANDBREAKS,break);
IF
LENGTH(the_command) = 0
THEN
IF
LENGTH(the_arguments) > 0
THEN
the_command ← LOP(the_arguments);
SCAN(the_arguments,TOKENBREAKS,break);
END "command read";
END "FETCH"